perm filename CRYPT.FAI[2,JMC]1 blob sn#124965 filedate 1974-10-12 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	CRYPT
C00003 00003	FAC←1 ↔ SWAC←2 ↔ CNT1←3			FILE NAME SCANNER
C00008 00004	STACK:	BLOCK	10
C00011 ENDMK
C⊗;
	TITLE	CRYPT
S:	MOVSI	2,S-LAST	;TAMPERING DETECTOR
	MOVEI	3,0
	MOVE	4,S(2)
	FMP	4,0
	ROT	3,1
	ADD	3,4
	AOBJN	2,S+2
	CAMN	3,1
	JRST	GO
	HALT
FAC←1 ↔ SWAC←2 ↔ CNT1←3			;FILE NAME SCANNER

DMODE:	10		;DEVICE AND MODE SPEC
DEV:	0
IOBUF:	0

FN1:	0		;FILE NAME SPEC
FN2:	0
PROT:	0
PPN:	0

DEFN1:	0		;DEFAULT FILE NAME
DEFN2:	0		;DEFAULT EXTENSION
DEFPN:	0		;DEFAULT PPN
DEFDV:	SIXBIT	/DSK/	;DEFAULT DEVICE

PNTR:	0

RDFIL:	SETZ	SWAC,		;FIRST NAME AND/OR DEVICE
	MOVE	0,DEFDV
	MOVEM	0,DEV
	MOVE	0,DEFN2
	MOVEM	0,FN2
	MOVE	0,DEFPN
	MOVEM	0,PPN
TRYG:	MOVE	0,DEFN1
	MOVEM	0,FN1
	MOVE	0,[POINT 6,FN1]
	MOVEM	0,PNTR
	MOVEI	CNT1,6
	INCHWL	FAC
FNL:	JUMPN	SWAC,QUOT
	CAIN	FAC,":"		;IN CASE OF DEVICE
	JRST	[ MOVE	0,FN1
		  CAIL	CNT1,6
		  SETZ	0,
		  MOVEM	0,DEV
		  JRST	TRYG]
	CAIN	FAC,"."
	JRST	DOTP
	CAIN	FAC,"["
	JRST	PARP
	CAIN	FAC," "
	JRST	NOP
QUOT:	CAIE	FAC,"↓"
	JRST	NQ
	CAIL	CNT1,6
	SETZM	FN1
	XOR	SWAC,1
	ADDI	CNT1,1
	JRST	NOP
NQ:	CAIN	FAC,15
	JRST	TERP
	CAIN	FAC,12
	JRST	TERP
	CAIN	FAC,175
	JRST	TERP
	CAIGE	FAC,40
	JRST	[ FNER:	OUTSTR [ASCIZ "ILLEGAL FILE NAME, TRY AGAIN:"]
			CLRBFI
			JRST   RDFIL ]
	CAIL	FAC,140
	SUBI	FAC,40
	SUBI	FAC,40
	CAIL	CNT1,6
	SETZM	FN1
	IDPB	FAC,PNTR
NOP:	INCHWL	FAC
	SOJGE	CNT1,FNL
	JRST	FNER

DOTP:	SETZM	FN2			;EXTENSION
	MOVE	0,[POINT 6,FN2]
	MOVEM	0,PNTR
	MOVEI	CNT1,3
	INCHWL	FAC
FNL2:	JUMPN	SWAC,QUOT2
	CAIN	FAC,"["
	JRST	PARP
	CAIN	FAC," "
	JRST	NOP2
QUOT2:	CAIE	FAC,"↓"
	JRST	NQ2
	XOR	SWAC,1
	ADDI	CNT1,1
	JRST	NOP2
NQ2:	CAIN	FAC,15
	JRST	TERP
	CAIN	FAC,12
	JRST	TERP
	CAIN	FAC,175
	JRST	TERP
	CAIGE	FAC,40
	JRST	FNER
	CAIL	FAC,140
	SUBI	FAC,40
	SUBI	FAC,40
	IDPB	FAC,PNTR
NOP2:	INCHWL	FAC
	SOJGE	CNT1,FNL2
	JRST	FNER

PARP:	HRRZ	0,PPN			;PROJECT NAME
	MOVEM	0,PPN
	MOVE	0,[POINT 6,PPN]
	MOVEM	0,PNTR
	MOVEI	CNT1,3
	INCHWL	FAC
FNL3:	JUMPN	SWAC,QUOT3
	CAIN	FAC,"]"
	JRST	TERP
	CAIN	FAC,","
	JRST	COMP
	CAIN	FAC," "
	JRST	NOP3
QUOT3:	CAIE	FAC,"↓"
	JRST	NQ3
	XOR	SWAC,1
	ADDI	CNT1,1
	JRST	NOP3
NQ3:	CAIN	FAC,15
	JRST	TERP
	CAIN	FAC,12
	JRST	TERP
	CAIN	FAC,175
	JRST	TERP
	CAIGE	FAC,40
	JRST	FNER
	CAIL	FAC,140
	SUBI	FAC,40
	SUBI	FAC,40
	IDPB	FAC,PNTR
NOP3:	INCHWL	FAC
	SOJGE	CNT1,FNL3
	JRST	FNER

COMP:	HLLZ	0,PPN			;PROGRAMMER NAME
	MOVEM	0,PPN
	MOVE	0,[POINT 6,PPN,3*6-1]
	MOVEM	0,PNTR
	MOVEI	CNT1,3
	INCHWL	FAC
FNL4:	JUMPN	SWAC,QUOT4
	CAIN	FAC,"]"
	JRST	TERP
	CAIN	FAC," "
	JRST	NOP4
QUOT4:	CAIE	FAC,"↓"
	JRST	NQ4
	ADDI	CNT1,1
	XOR	SWAC,1
	JRST	NOP4
NQ4:	CAIN	FAC,15
	JRST	TERP
	CAIN	FAC,12
	JRST	TERP
	CAIN	FAC,175
	JRST	TERP
	CAIGE	FAC,40
	JRST	FNER
	CAIL	FAC,140
	SUBI	FAC,40
	SUBI	FAC,40
	IDPB	FAC,PNTR
NOP4:	INCHWL	FAC
	SOJGE	CNT1,FNL4
	JRST	FNER

TERP:	CAIE	FAC,175			;END OF INPUT LINE
	CAIN	FAC,12
	POPJ	17,
	INCHWL	FAC
	JRST	TERP
STACK:	BLOCK	10

IHD:	BLOCK	3
OHD:	BLOCK	3
KEY1←15 ↔ KEY2←16

GO:	MOVEI	17,STACK
	OUTSTR	[ASCIZ "ENCODE OR DECODE:"]
FMO:	SETZ	5,
INLM:	INCHWL	2
	JUMPN	5,STAN
	ANDI	2,37
	MOVE	5,2
STAN:	CAIN	2,15
	INCHWL	2
	CAIN	2,12
	JRST	IDNM
	CAIE	2,175
	JRST	INLM
IDNM:	CAIE	5,4
	CAIN	5,5
	JRST	MOK
	OUTSTR	[ASCIZ "WHAZZAT? TRY AGAIN:"]
	JRST	FMO
MOK:	OUTSTR	[ASCIZ "INPUT FILE:"]
	MOVE	0,[ 0,,IHD]
	MOVEM	0,IOBUF
	MOVEI	0,14
	MOVEM	0,DMODE
INFL:	PUSHJ	17,RDFIL
	OPEN	1,DMODE
	JRST	.+2
	LOOKUP	1,FN1
	JRST	[ OUTSTR [ASCIZ "CAN'T FIND IT, TRY AGAIN:"]
		  JRST	INFL]
	OUTSTR	[ASCIZ	"OUTPUT FILE:"]
	MOVE	0,[ OHD,,0]
	MOVEM	0,IOBUF
	MOVEI	0,14
	MOVEM	0,DMODE
OUFL:	PUSHJ	17,RDFIL
	OPEN	2,DMODE
	JRST	.+2
	ENTER	2,FN1
	JRST	[ OUTSTR [ASCIZ "CAN'T WRITE THERE, TRY AGAIN:"]
		  JRST	OUFL]
	OUTSTR	[ASCIZ "KEYWORD:"]
	CTLV
	SETO	KEY1,
INL:	INCHWL	2
	CAIN	2,15
	INCHWL	2
	CAIE	2,12
	CAIN	2,175
	JRST	IDN
	ANDI	2,177
	CAIL	2,140
	SUBI	2,40
	CAIGE	2,40
	ADDI	2,40
	ROT	KEY1,11
	XOR	KEY1,2
	JRST	INL
IDN:	CTLV
	CLRBFI
	MOVS	KEY2,KEY1
	INPUT	1,0
	OUTPUT	2,0
	CAIE	5,5
	JRST	DEC
	ACCTIM	4,
	IMULI	4,377775
	IDPB	4,OHD+1
	SOS	OHD+2
	JRST	RDL
DEC:	ILDB	4,IHD+1
	SOS	IHD+2
RDL:	XOR	KEY1,4
RDLOOP:	SKIPN	IHD+2
	IN	1,0
	JRST	NOIN
	OUTPUT	2,0
	CLOSE	1,0
	CLOSE	2,0
	EXIT
NOIN:	ILDB	1,IHD+1
	IMULI	KEY1,377775
	IMULI	KEY2,100003
	MOVEI	14,44
	SETZB	12,13
RLOOP:	TRNE	KEY1,1			;BESM-6 BIT MAP, BUT MORE SO
	JRST	AONE
	TRNE	KEY2,1
	TRON	12,1
	ROT	12,-1
	JRST	BDON
AONE:	ROT	13,1
	TRNE	KEY2,1
	TRON	13,1
BDON:	ROTC	KEY1,-1
	SOJG	14,RLOOP
	EXCH	KEY1,KEY2
	OR	12,13
	XOR	1,12
	SOS	IHD+2
	SKIPN	OHD+2
	OUTPUT	2,0
	IDPB	1,OHD+1
	SOS	OHD+2
LAST:	JRST	RDLOOP
	END GO